Tech Arsenal 1

home *** CD-ROM | disk | FTP | other *** search

/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSAM.EXE / BDCLINK.PRG < prev next >

Wrap

Text File | 1993-05-11 | 46KB | 1,571 lines

*-- DBW - Dialog Box Workshop - BDCLINK.PRG PROCEDURE BDCLINK *---------------------------------------------------------------------------- * NAME * DESCRIPTION *---------------------------------------------------------------------------- PRIVATE cAlias, cWindow, lTalk, lSafety, cDialog, cHelpFile, cStartLib IF SET( "TALK" ) = "ON" SET TALK OFF lTalk = .T. ELSE lTalk = .F. ENDIF lSafety = SET( "SAFETY" ) = "ON" SET SAFETY OFF cWindow = WINDOW() cAlias = ALIAS() *---------------------------------- *-- Setup the help system variables *---------------------------------- lError = .F. cHelpFile = "BDCDRIVE" cDialog = "BDCLINK" cDBBLib = "DBBLIB" *---------------------------------------------- *-- Setup the link to the DBB Procedure Library *---------------------------------------------- ON ERROR lError = .T. cStartLib = SET( "PROCEDURE" ) SET PROCEDURE TO ( cDBBLib ) IF lError lError = .F. SET PROCEDURE TO HOME() + cDBBLib IF lError *-- Display the error message in a windowed box PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,; ll_escape lc_anykey = [Press any key to continue...] ln_press = LEN( lc_anykey ) lc_msg = [Could not locate procedure file: ] + cDBBLib ln_msglen = LEN( lc_msg ) ln_width = 0 ll_escape = SET("ESCAPE") = "ON" SET ESCAPE OFF *-- Determine the width needed for the window: IF ln_msglen <= ln_press ln_width = ln_press ELSE *-- Make sure the message fits in the window: IF ln_msglen > 76 lc_msg = LEFT( lc_msg, 76 ) ln_msglen = 76 ENDIF ln_width = ln_msglen ENDIF DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ; TO 15, (ln_width + 83) / 2 DOUBLE ln_width = ( ln_width + 2 ) *-- Display the message and prompt to the window and wait for a key press ACTIVATE WINDOW _err_box ? lc_msg AT ( ln_width - ln_msglen ) / 2 ? ? lc_anykey AT ( ln_width - ln_press ) / 2 SET CONSOLE OFF WAIT SET CONSOLE ON *-- Clean up the window display and reactivate the previous window RELEASE WINDOW _err_box IF ll_escape SET ESCAPE ON ELSE SET ESCAPE OFF ENDIF ENDIF ENDIF ON ERROR *--------------------------------- *-- Run the actual dialog box code *--------------------------------- IF .NOT. lError DO Dialog ENDIF *---------------------------------- *-- Restore the startup environment *---------------------------------- IF .NOT. ISBLANK( cStartLib ) SET PROCEDURE TO ( cStartLib ) ENDIF IF .NOT. ISBLANK( cAlias ) .AND. SELECT( cAlias ) > 0 SELECT ( cAlias ) ENDIF IF lSafety SET SAFETY ON ENDIF IF lTalk SET TALK ON ENDIF IF .NOT. ISBLANK( cWindow ) ACTIVATE WINDOW &cWindow ENDIF RETURN *-- EOP: BDCLINK PROCEDURE Dialog *---------------------------------------------------------------------------- * NAME * Dialog - * * DESCRIPTION * *---------------------------------------------------------------------------- *--------------------------------------- *-- Temporary for now, message varaibles *--------------------------------------- DLN_OK = -500 DLN_CANCEL = -501 DLN_HELP = -502 WM_PAINT = 15 && Notification to repaint client area WM_CLOSE = 16 && Note that user selected close button WM_DRAWITEM = 43 && Notification to the owner of an BN_CLICKED = 0 BN_PAINT = 1 BN_HILITE = 2 BN_UNHILITE = 3 BN_DISABLE = 4 BN_DEFAULT = 6 BN_PRESSED = 7 BN_COLOR = 8 SE_SHADOW = -100 EN_SETFOCU = 1 EN_KILLFOC = 2 CB_SELECTS = 13 CB_SHOWDRO = 15 CB_HIDELST = 25 CBN_SELCHAN = 1 CBN_DBLCLK = 2 CBN_SETFOCU = 3 CBN_KILLFOC = 4 CBN_EDITCHA = 5 CBN_EDITUPD = 6 CBN_DROPDOW = 7 CBN_INLIST = 8 LBN_SELCHA = 1 LBN_DBLCLK = 2 LBN_SELCAN = 3 LBN_SETFOC = 4 LBN_KILLFO = 5 KB_TAB = 9 KB_ENTER = 13 KB_SPACE = 32 KB_SHIFTTAB = -400 KB_UPARROW = 5 KB_DOWNARROW = 24 KB_LEFTARROW = 19 KB_RTARROW = 4 KB_F1 = 28 KB_ESC = 27 KB_MOUSE = -100 KB_CTRLW = 23 *-------------------- *-- Working variables *-------------------- PRIVATE nCurrent, nCurrGrp, lButtAct, nMRow, nMCol, nMsEvent, nDlgDef, nAccel PRIVATE n1stGrp, nCancelBt nCurrent = 0 && Current dialog object id nCurrGrp = 0 && Current group id for object id lButtAct = .F. && Dialog has a button active nMRow = -1 nMCol = -1 nMsEvent = 0 nDlgDef = 0 nAccel = 0 n1stGrp = 0 nCancelBt = 0 && Id for cancel button PRIVATE nDefButt, nMess nDefButt = 0 && Number of object with default button nMess = 0 PRIVATE cOldFClr, cOldBClr, cOldHClr, cOldMClr, cOldNClr, cOldTClr cOldFClr = _ColorChk( "F" ) cOldBClr = _ColorChk( "B" ) cOldHClr = _ColorChk( "H" ) cOldMClr = _ColorChk( "M" ) cOldNClr = _ColorChk( "N" ) cOldTClr = _ColorChk( "T" ) SET COLOR OF FIELDS TO w+/b SET COLOR OF BOX TO n/gb SET COLOR OF HIGH TO w+/g SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb *------------------------ *-- Close Icon for window *------------------------ PRIVATE nRowCls, nOrigRow, nOrigCol, nXoffset, nYOffset, nCol, ; nHigh, nWidth, nLColCls, nRColCls, nRWinCol, cField, cClass, nScreen cField = "" cClass = "" nRowCls = 9 nOrigRow = 9 nOrigCol = 15 nXOffset = 0 nYOffset = 0 nCol = 15 nHigh = 14 nWidth = 54 nLColCls = 17 nRColCls = 19 nRWinCol = 68 nScreen = IIF( "50" $ SET("DISPLAY"), 49, ; IIF( "43" $ SET("DISPLAY"), 42, 24 ) ) IF SET( "STATUS" ) = "ON" nScreen = nScreen - 3 ENDIF PRIVATE nClkBox, nClkObj, aClkBox, aClkObj, aObjPoint *-------------------------------------------------- *-- Get the number of clickable boxes in the dialog *-------------------------------------------------- nClkBox = 0 *-------------------------------------------------- *-- Get the number of clickable items in the dialog *-------------------------------------------------- nClkObj = 6 DECLARE aClkObj[ 6 , 13 ] aClkObj[ 1 , 1 ] = 12 && Row aClkObj[ 1 , 2 ] = 38 && Col aClkObj[ 1 , 3 ] = 62 && Decimals aClkObj[ 1 , 4 ] = 7 && CurrentId aClkObj[ 1 , 5 ] = 6 && GroupId aClkObj[ 1 , 6 ] = 13 && NextId aClkObj[ 1 , 7 ] = 28 && PrevId aClkObj[ 1 , 8 ] = " " && PickKey aClkObj[ 1 , 9 ] = 7 && Previous item in group aClkObj[ 1 ,10 ] = 7 && Next item in group aClkObj[ 1 ,11 ] = "EF_EXEP_1" && XXXXXXXXXXXXXXXXXXXXXXXXX aClkObj[ 1 ,12 ] = [] aClkObj[ 1 ,13 ] = [] aClkObj[ 2 , 1 ] = 14 && Row aClkObj[ 2 , 2 ] = 38 && Col aClkObj[ 2 , 3 ] = 62 && Decimals aClkObj[ 2 , 4 ] = 13 && CurrentId aClkObj[ 2 , 5 ] = 12 && GroupId aClkObj[ 2 , 6 ] = 19 && NextId aClkObj[ 2 , 7 ] = 7 && PrevId aClkObj[ 2 , 8 ] = " " && PickKey aClkObj[ 2 , 9 ] = 13 && Previous item in group aClkObj[ 2 ,10 ] = 13 && Next item in group aClkObj[ 2 ,11 ] = "EF_CONF_1" && XXXXXXXXXXXXXXXXXXXXXXXXX aClkObj[ 2 ,12 ] = [] aClkObj[ 2 ,13 ] = [] aClkObj[ 3 , 1 ] = 16 && Row aClkObj[ 3 , 2 ] = 38 && Col aClkObj[ 3 , 3 ] = 62 && Decimals aClkObj[ 3 , 4 ] = 19 && CurrentId aClkObj[ 3 , 5 ] = 18 && GroupId aClkObj[ 3 , 6 ] = 26 && NextId aClkObj[ 3 , 7 ] = 13 && PrevId aClkObj[ 3 , 8 ] = " " && PickKey aClkObj[ 3 , 9 ] = 19 && Previous item in group aClkObj[ 3 ,10 ] = 19 && Next item in group aClkObj[ 3 ,11 ] = "EF_EXEF_1" && XXXXXXXXXXXXXXXXXXXXXXXXX aClkObj[ 3 ,12 ] = [] aClkObj[ 3 ,13 ] = [] aClkObj[ 4 , 1 ] = 19 && Row aClkObj[ 4 , 2 ] = 26 && Col aClkObj[ 4 , 3 ] = 33 && Decimals aClkObj[ 4 , 4 ] = 26 && CurrentId aClkObj[ 4 , 5 ] = 26 && GroupId aClkObj[ 4 , 6 ] = 27 && NextId aClkObj[ 4 , 7 ] = 19 && PrevId aClkObj[ 4 , 8 ] = " " && PickKey aClkObj[ 4 , 9 ] = 26 && Previous item in group aClkObj[ 4 ,10 ] = 26 && Next item in group aClkObj[ 4 ,11 ] = "BT_OK" && Ok aClkObj[ 4 ,12 ] = [] aClkObj[ 4 ,13 ] = [] aClkObj[ 5 , 1 ] = 19 && Row aClkObj[ 5 , 2 ] = 38 && Col aClkObj[ 5 , 3 ] = 45 && Decimals aClkObj[ 5 , 4 ] = 27 && CurrentId aClkObj[ 5 , 5 ] = 27 && GroupId aClkObj[ 5 , 6 ] = 28 && NextId aClkObj[ 5 , 7 ] = 26 && PrevId aClkObj[ 5 , 8 ] = " " && PickKey aClkObj[ 5 , 9 ] = 27 && Previous item in group aClkObj[ 5 ,10 ] = 27 && Next item in group aClkObj[ 5 ,11 ] = "BT_CANCEL" && Cancel aClkObj[ 5 ,12 ] = [] aClkObj[ 5 ,13 ] = [] nCancelBt = 27 aClkObj[ 6 , 1 ] = 19 && Row aClkObj[ 6 , 2 ] = 50 && Col aClkObj[ 6 , 3 ] = 57 && Decimals aClkObj[ 6 , 4 ] = 28 && CurrentId aClkObj[ 6 , 5 ] = 28 && GroupId aClkObj[ 6 , 6 ] = 7 && NextId aClkObj[ 6 , 7 ] = 27 && PrevId aClkObj[ 6 , 8 ] = " " && PickKey aClkObj[ 6 , 9 ] = 28 && Previous item in group aClkObj[ 6 ,10 ] = 28 && Next item in group aClkObj[ 6 ,11 ] = "BT_HELP" && Help aClkObj[ 6 ,12 ] = [] aClkObj[ 6 ,13 ] = [] *------------------------------------------------------------- *-- Setup object pointers in to the current object array above *------------------------------------------------------------- DECLARE aObjPoint[ 33 ] aObjPoint[ 7 ] = 1 aObjPoint[ 13 ] = 2 aObjPoint[ 19 ] = 3 aObjPoint[ 26 ] = 4 aObjPoint[ 27 ] = 5 aObjPoint[ 28 ] = 6 *------------------------------------------------------------------- *-- Setup private memory variables for object states (from InitObjs) *-- First variable with the object memvar name contains the value *-- for the object. The second varaible, if present, indicates *-- the id of the object previously active in the group. *------------------------------------------------------------------- PRIVATE ef_exep_1 ef_exep_1 = "" PRIVATE ef_conf_1 ef_conf_1 = "" PRIVATE ef_exef_1 ef_exef_1 = "" PRIVATE bt_ok bt_ok = "" PRIVATE bt_cancel bt_cancel = "" PRIVATE bt_help bt_help = "" DO InitObjs DO DrawDial && Draw all the dialog objects *-------------------------------- *-- Set focus to the first object *-------------------------------- DO GetNext WITH nCurrent, .T. *-- The message loop nMess = 0 DO WHILE .NOT. GetMess() DO Dispatch IF nMess = DLN_OK .OR. nMess = DLN_CANCEL EXIT ENDIF ENDDO IF nMess = DLN_OK DO PostVals FXL_Cancel = .F. ELSE FXL_Cancel = .T. ENDIF RELEASE WINDOW BDCLINK RESTORE SCREEN FROM BDCLINK RELEASE SCREEN BDCLINK DO ReleObjs SET COLOR OF FIELDS TO &cOldFClr SET COLOR OF BOX TO &cOldBClr SET COLOR OF HIGH TO &cOldHClr SET COLOR OF MESS TO &cOldMClr SET COLOR OF TITLE TO &cOldTClr SET CURSOR ON RETURN *-- EOP: Dialog PROCEDURE InitObjs *---------------------------------------------------------------------------- * NAME * InitObjs - Scan the design DBF file and initialize the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE cField, cClass, cDefault, Value, lInitDef *-------------------------------------------------- *-- Determine if an initialization array is present *-------------------------------------------------- lInitDef = TYPE( "BDCLINK[1]" ) <> "U" *------------------------------- *-- Set the default button value *------------------------------- nDlgDef = 26 *----------------------------------------------------------------- *-- If the Initialize array is present, then set the object values *-- based on the array. *----------------------------------------------------------------- IF lInitDef EF_EXEP_1 = BDCLINK[ 1 ] EF_CONF_1 = BDCLINK[ 2 ] EF_EXEF_1 = BDCLINK[ 3 ] BT_OK = BDCLINK[ 4 ] BT_CANCEL = BDCLINK[ 5 ] BT_HELP = BDCLINK[ 6 ] ELSE *-------------------------------------------------------- *-- Otherwise, use the values stored in the resource file *-------------------------------------------------------- EF_EXEP_1 = " " EF_CONF_1 = " " EF_EXEF_1 = " " BT_OK = .T. BT_CANCEL = .F. BT_HELP = .F. ENDIF nCurrent = 7 && Current dialog object id nCurrGrp = 6 && Current group id for object id n1stGrp = 6 RETURN *-- EOP: InitObjs PROCEDURE DrawDial *---------------------------------------------------------------------------- * NAME * DrawDial - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lInitDef lInitDef = TYPE( "BDCLINK[1]" ) <> "U" IF FILE( "BDCLINK.WIN" ) .AND. ( .NOT. lInitDef .OR. ; ( TYPE( "FXL_NoChng" ) = "L" .AND. FXL_NoChng ) ) *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO BDCLINK ACTIVATE SCREEN @ 10, 16 FILL TO 23, 69 RESTORE WINDOW BDCLINK FROM BDCLINK ACTIVATE WINDOW BDCLINK ELSE *------------------------- *-- Draw the dialog window *------------------------- *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO BDCLINK ACTIVATE SCREEN @ 10, 16 FILL TO 23, 69 DEFINE WINDOW BDCLINK FROM 9,15 TO 22,68 NONE COLOR n/w ACTIVATE WINDOW BDCLINK @ 0, 0 TO 13 , 53 DOUBLE COLOR w+/w *------------------------ *-- Close Icon for window *------------------------ @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w *--------------------------------- *-- Draw the other control objects *--------------------------------- @ 0,17 SAY "[ Linker Options ]" COLOR w+/w @ 2,3 SAY "┌──────────────────────────────────────────────" COLOR n/w @ 2,50 SAY "┐" COLOR w+/w @ 3,3 SAY "│" COLOR n/w @ 3,50 SAY "│" COLOR w+/w @ 4,3 SAY "│" COLOR n/w @ 4,50 SAY "│" COLOR w+/w @ 5,3 SAY "│" COLOR n/w @ 5,50 SAY "│" COLOR w+/w @ 6,3 SAY "│" COLOR n/w @ 6,50 SAY "│" COLOR w+/w @ 7,3 SAY "│" COLOR n/w @ 7,50 SAY "│" COLOR w+/w @ 8,3 SAY "└" COLOR n/w @ 8,4 SAY "──────────────────────────────────────────────┘" COLOR w+/w @ 9,9 SAY "┌───────────────────────────────────" COLOR w+/w @ 9,45 SAY "┐" COLOR n/w @ 10,9 SAY "│" COLOR w+/w @ 10,45 SAY "│" COLOR n/w @ 11,9 SAY "│" COLOR w+/w @ 11,45 SAY "│" COLOR n/w @ 12,9 SAY "└" COLOR w+/w @ 12,10 SAY "───────────────────────────────────┘" COLOR n/w DO TStatic WITH WM_PAINT, BN_PAINT, 6 DO TEdit WITH WM_PAINT, EN_KILLFOC, 7 DO TStatic WITH WM_PAINT, BN_PAINT, 12 DO TEdit WITH WM_PAINT, EN_KILLFOC, 13 DO TStatic WITH WM_PAINT, BN_PAINT, 18 DO TEdit WITH WM_PAINT, EN_KILLFOC, 19 DO TButton WITH WM_PAINT, BN_PAINT, 26 DO TButton WITH WM_PAINT, SE_SHADOW, 26 DO TButton WITH WM_PAINT, BN_PAINT, 27 DO TButton WITH WM_PAINT, SE_SHADOW, 27 DO TButton WITH WM_PAINT, BN_PAINT, 28 DO TButton WITH WM_PAINT, SE_SHADOW, 28 IF .NOT. lInitDef SAVE WINDOW BDCLINK TO BDCLINK ENDIF ENDIF RETURN *-- EOP: DrawDial PROCEDURE TStatic PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TStatic - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 6 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 3, 5 SAY 'Execute program' COLOR n/w CASE pc_data = BN_HILITE @ 3, 5 SAY 'Execute program' COLOR w+/w CASE pc_data = BN_DISABLE @ 3, 5 SAY 'Execute program' COLOR n+/w CASE pc_data = BN_COLOR @ 3, 5 SAY "~Execute program" COLOR n/w ENDCASE IF pc_data <> BN_DISABLE @ 3, 5 SAY "E" COLOR gr+/w ENDIF CASE pnObject = 12 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 5, 6 SAY 'Config.DB file' COLOR n/w CASE pc_data = BN_HILITE @ 5, 6 SAY 'Config.DB file' COLOR w+/w CASE pc_data = BN_DISABLE @ 5, 6 SAY 'Config.DB file' COLOR n+/w CASE pc_data = BN_COLOR @ 5, 6 SAY "~Config.DB file" COLOR n/w ENDCASE IF pc_data <> BN_DISABLE @ 5, 6 SAY "C" COLOR gr+/w ENDIF CASE pnObject = 18 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 7, 7 SAY 'EXE file name' COLOR n/w CASE pc_data = BN_HILITE @ 7, 7 SAY 'EXE file name' COLOR w+/w CASE pc_data = BN_DISABLE @ 7, 7 SAY 'EXE file name' COLOR n+/w CASE pc_data = BN_COLOR @ 7, 7 SAY "EXE ~file name" COLOR n/w ENDCASE IF pc_data <> BN_DISABLE @ 7, 11 SAY "f" COLOR gr+/w ENDIF ENDCASE RETURN *-- EOP: TStatic WITH pn_msg, pc_data, pnObject PROCEDURE HasTitle PARAMETERS pnObject, pnWay *---------------------------------------------------------------------------- * NAME * HasTitle - Display the label for the group of objects * * DESCRIPTION * * PARAMETERS * pnObject = nCurrent value for group item * pnWay = BN_HILITE, BN_UNHILITE, or BN_DISABLE * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 7 DO TStatic WITH WM_PAINT, pnWay, 6 CASE pnObject = 13 DO TStatic WITH WM_PAINT, pnWay, 12 CASE pnObject = 19 DO TStatic WITH WM_PAINT, pnWay, 18 ENDCASE *-- EOP: HasTitle WITH pnObject, pnWay FUNCTION GetMess *---------------------------------------------------------------------------- * NAME * GetMess() - * DEPENDENCIES * Uses nCurrent to determine the wait state for the given object. *---------------------------------------------------------------------------- PRIVATE lRtn DO CASE CASE nCurrent = 7 && EF_EXEP_1 DO GetEdit CASE nCurrent = 13 && EF_CONF_1 DO GetEdit CASE nCurrent = 19 && EF_EXEF_1 DO GetEdit CASE nCurrent = 26 && BT_OK DO GetWait CASE nCurrent = 27 && BT_CANCEL DO TButton WITH WM_PAINT, BN_UNHILITE, 26 BT_CANCEL = .F. DO GetWait CASE nCurrent = 28 && BT_HELP DO TButton WITH WM_PAINT, BN_UNHILITE, 26 BT_HELP = .F. DO GetWait ENDCASE IF nMess = KB_F1 DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile ENDIF IF nMess = KB_ESC lRtn = .T. ELSE lRtn = .F. ENDIF RETURN lRtn *-- EOF: GetMess( ) PROCEDURE GetWait *---------------------------------------------------------------------------- * NAME * GetWait - * * DESCRIPTION * *---------------------------------------------------------------------------- nMess = 0 nAccel = 0 lButtAct = .T. DO TButton WITH WM_PAINT, BN_HILITE, nCurrent SET CONSOLE OFF SET CURSOR OFF WAIT SET CONSOLE ON nMess = LASTKEY() nMRow = MROW() nMCol = MCOL() RETURN *-- EOP: GetWait PROCEDURE TButton PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TButton - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 26 && BT_OK DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 10, 11 SAY ' Ok ' COLOR bg+/g CASE pc_data = BN_HILITE @ 10, 11 SAY ' Ok ' COLOR w+/g CASE pc_data = BN_UNHILITE @ 10, 11 SAY ' Ok ' COLOR n/g CASE pc_data = BN_DEFAULT @ 10, 11 SAY ' Ok ' COLOR bg+/g CASE pc_data = BN_DISABLE @ 10, 11 SAY ' Ok ' COLOR n+/g CASE pc_data = SE_SHADOW @ 11, 12 SAY "▀▀▀▀▀▀▀▀" @ 10, 19 SAY "▄" CASE pc_data = BN_PRESSED @ 11, 12 SAY SPACE( 8 ) @ 10, 11 SAY " " @ 10, 19 SAY " " @ 10, 12 SAY ' Ok ' COLOR w+/g ENDCASE CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 26 x = INKEY( .2 ) nMess = DLN_OK DO TButton WITH WM_PAINT, BN_PAINT, 26 DO TButton WITH WM_PAINT, SE_SHADOW, 26 ENDCASE CASE pnObject = 27 && BT_CANCEL DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 10, 23 SAY ' Cancel ' COLOR n/g CASE pc_data = BN_HILITE @ 10, 23 SAY ' Cancel ' COLOR w+/g CASE pc_data = BN_UNHILITE @ 10, 23 SAY ' Cancel ' COLOR n/g CASE pc_data = BN_DEFAULT @ 10, 23 SAY ' Cancel ' COLOR bg+/g CASE pc_data = BN_DISABLE @ 10, 23 SAY ' Cancel ' COLOR n+/g CASE pc_data = SE_SHADOW @ 11, 24 SAY "▀▀▀▀▀▀▀▀" @ 10, 31 SAY "▄" CASE pc_data = BN_PRESSED @ 11, 24 SAY SPACE( 8 ) @ 10, 23 SAY " " @ 10, 31 SAY " " @ 10, 24 SAY ' Cancel ' COLOR w+/g ENDCASE CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 27 x = INKEY( .2 ) nMess = DLN_CANCEL DO TButton WITH WM_PAINT, BN_PAINT, 27 DO TButton WITH WM_PAINT, SE_SHADOW, 27 ENDCASE CASE pnObject = 28 && BT_HELP DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 10, 35 SAY ' Help ' COLOR n/g CASE pc_data = BN_HILITE @ 10, 35 SAY ' Help ' COLOR w+/g CASE pc_data = BN_UNHILITE @ 10, 35 SAY ' Help ' COLOR n/g CASE pc_data = BN_DEFAULT @ 10, 35 SAY ' Help ' COLOR bg+/g CASE pc_data = BN_DISABLE @ 10, 35 SAY ' Help ' COLOR n+/g CASE pc_data = SE_SHADOW @ 11, 36 SAY "▀▀▀▀▀▀▀▀" @ 10, 43 SAY "▄" CASE pc_data = BN_PRESSED @ 11, 36 SAY SPACE( 8 ) @ 10, 35 SAY " " @ 10, 43 SAY " " @ 10, 36 SAY ' Help ' COLOR w+/g ENDCASE CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 28 DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile DO TButton WITH WM_PAINT, BN_PAINT, 28 DO TButton WITH WM_PAINT, SE_SHADOW, 28 ENDCASE ENDCASE RETURN *-- EOP: TButton WITH pn_msg, pc_data, pnObject PROCEDURE GetEdit *---------------------------------------------------------------------------- * NAME * GetEdit - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lSkipRead lSkipRead = .F. nMess = 0 nAccel = 0 nMsEvent = 0 ON MOUSE DO MsHand WITH MROW(), MCOL() DO SetOnKey DO CASE CASE nCurrent = 7 @ 3, 23 GET EF_EXEP_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" CASE nCurrent = 13 @ 5, 23 GET EF_CONF_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" CASE nCurrent = 19 @ 7, 23 GET EF_EXEF_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" ENDCASE IF .NOT. lSkipRead SET CURSOR ON READ SET CURSOR OFF ENDIF DO ClrOnKey ON MOUSE IF .NOT. lSkipRead IF nMsEvent = KB_MOUSE nMess = KB_MOUSE ELSE nMess = LASTKEY() ENDIF ELSE nMess = KB_DOWNARROW ENDIF RETURN *-- EOP: GetEdit PROCEDURE TEdit PARAMETERS pn_msg, p__data, pnObject *---------------------------------------------------------------------------- * NAME * TEdit - * * DESCRIPTION * * PARAMETERS * pn_msg = * p__data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 7 && EF_EXEP_1 DO CASE CASE p__data = EN_KILLFOC @ 3, 23 GET EF_EXEP_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" CLEAR GETS ENDCASE CASE pnObject = 13 && EF_CONF_1 DO CASE CASE p__data = EN_KILLFOC @ 5, 23 GET EF_CONF_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" CLEAR GETS ENDCASE CASE pnObject = 19 && EF_EXEF_1 DO CASE CASE p__data = EN_KILLFOC @ 7, 23 GET EF_EXEF_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXX" CLEAR GETS ENDCASE ENDCASE RETURN *-- EOP: TEdit WITH pn_msg, p__data, pnObject PROCEDURE SetOnKey *---------------------------------------------------------------------------- * NAME * SetOnKey - For each pick key, set on key label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-E DO AKeyHand WITH '7' ON KEY LABEL Alt-C DO AKeyHand WITH '13' ON KEY LABEL Alt-f DO AKeyHand WITH '19' RETURN *-- EOP: SetOnKey PROCEDURE ClrOnKey *---------------------------------------------------------------------------- * NAME * ClrOnKey - For each pick key, clear on label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-E ON KEY LABEL Alt-C ON KEY LABEL Alt-f RETURN *-- EOP: ClrOnKey PROCEDURE AKeyHand PARAMETERS cId *---------------------------------------------------------------------------- * NAME * AKeyHand - On key handler for Accel key from popup or get * * DESCRIPTION * * PARAMETERS * nId = * *---------------------------------------------------------------------------- IF nAccel <> nCurrent nAccel = VAL( cId ) KEYBOARD "{Ctrl-W}" nMess = KB_CTRLW ELSE nAccel = 0 ENDIF RETURN *-- EOP: AKeyHand WITH nId PROCEDURE CkWaitAc *---------------------------------------------------------------------------- * NAME * CkWaitAc - Look for Accel key from Wait command * * DESCRIPTION * This routine has high International risk for translations. *---------------------------------------------------------------------------- IF nMess < 0 nAccPress = nMess + 500 ELSE IF nMess >= 97 .AND. nMess <= 122 nMess = nMess - 32 ENDIF nAccPress = nMess ENDIF DO CASE CASE nAccPress = 69 && E - EF_EXEP_0 nAccel = 7 CASE nAccPress = 67 && C - EF_CONF_0 nAccel = 13 CASE nAccPress = 70 && f - EF_EXEF_0 nAccel = 19 OTHERWISE nAccel = 0 ENDCASE RETURN *-- EOP: CkWaitAc FUNCTION GetMsTo PARAMETER plChkOnly *---------------------------------------------------------------------------- * NAME * GetMsTo() - * * DESCRIPTION * *---------------------------------------------------------------------------- *-- Check for a click on the close button IF nMRow = nRowCls .AND. nMCol >= nLColCls .AND. nMCol <= nRColCls nMess = DLN_CANCEL nRtn = 0 ELSE IF nMRow = nRowCls .AND. nMCol >= nCol .AND. nMCol <= nRWinCol *--------------------------------------------------------- *-- All this to remove the shadow before moving the window *--------------------------------------------------------- SAVE WINDOW BDCLINK TO _BDCLINK RELEASE WINDOW BDCLINK RESTORE SCREEN FROM BDCLINK RESTORE WINDOW BDCLINK FROM _BDCLINK ERASE _BDCLINK.win ACTIVATE WINDOW BDCLINK @ 0, 0 TO nHigh - 1, nWidth - 1 COLOR g+/w @ 0, 2 SAY "[ ]" COLOR g+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 17 SAY "[ Linker Options ]" COLOR g+/w *------------------------------- *-- Start the move window action *------------------------------- nDelX = nMRow nDelY = nMCol SET CONSOLE OFF WAIT SET CONSOLE ON nMRow = MROW() nMCol = MCOL() nDelX = nMRow - nDelX nDelY = nMCol - nDelY lMoveOk = .T. ON ERROR lMoveOk = .F. MOVE WINDOW BDCLINK BY nDelX, nDelY ON ERROR IF lMoveOk nRowCls = nRowCls + nDelX nCol = nCol + nDelY nLColCls = ncol + 2 && Left column for close button nRColCls = ncol + 4 && End column for close button nRWinCol = ncol + nWidth - 1 && Rigth column for window nXOffset = nRowCls - nOrigRow nYOffset = nCol - nOrigCol ENDIF *--------------------------------------------------------- *-- Display the new shadow for after moving the dialog box *--------------------------------------------------------- SAVE WINDOW BDCLINK TO _BDCLINK RELEASE WINDOW BDCLINK RESTORE SCREEN FROM BDCLINK ACTIVATE SCREEN IF nCol + 54 < 80 .AND. nRowCls + 14 <= nScreen @ nRowCls + 1, nCol + 1 FILL TO nRowCls + 14, nCol + 54 COLOR n+/n ENDIF RESTORE WINDOW BDCLINK FROM _BDCLINK ERASE _BDCLINK.win ACTIVATE WINDOW BDCLINK @ 0, 0 TO nHigh - 1, nWidth - 1 DOUBLE COLOR w+/w @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 17 SAY "[ Linker Options ]" COLOR w+/w nRtn = -1 ELSE *----------------------------------- *-- Check for click on a live object *----------------------------------- nRtn = 0 i = 1 DO WHILE i <= nClkObj IF nMRow = aClkObj[ i, 1 ] + nXOffSet .AND. ; nMCol >= aClkObj[ i, 2 ] + nYOffset .AND. ; nMCol <= aClkObj[ i, 3 ] + nYOffset nRtn = aClkObj[ i, 4 ] EXIT ENDIF i = i + 1 ENDDO IF nRtn = 0 *---------------------------------------------------------- *-- Not found, check for a click in a Combo box or list box *---------------------------------------------------------- IF nClkBox > 0 i = 1 DO WHILE i <= nClkBox IF nMRow >= aClkBox[ i, 1 ] + nXOffset .AND. ; nMRow <= aClkBox[ i, 1 ] + nXOffset + aClkBox[ i, 2 ] .AND. ; nMCol >= aClkBox[ i, 3 ] + nYOffset .AND. ; nMCol <= aClkBox[ i, 3 ] + nYOffset + aClkBox[ i, 4 ] nRtn = aClkBox[ i, 5 ] - 1 aClkBox[ i, 6 ] = .T. EXIT ENDIF i = i + 1 ENDDO ENDIF ENDIF ENDIF ENDIF RETURN( nRtn ) *-- EOF: GetMsTo( ) PROCEDURE MsHand PARAMETERS pnMRow, pnMCol, pl_IsPop *---------------------------------------------------------------------------- * NAME * MsHand - * * DESCRIPTION * * PARAMETERS * pnMRow = * pnMCol = * pl_IsPop = * *---------------------------------------------------------------------------- nMRow = pnMRow nMCol = pnMCol nMsEvent = KB_MOUSE KEYBOARD "{Ctrl-W}" RETURN *-- EOP: MsHand WITH pnMRow, pnMCol, pl_IsPop PROCEDURE Dispatch *---------------------------------------------------------------------------- * NAME * Dispatch - * * DESCRIPTION * *---------------------------------------------------------------------------- DO CASE CASE nCurrent = 7 && EF_EXEP_1 DO DispEf CASE nCurrent = 13 && EF_CONF_1 DO DispEf CASE nCurrent = 19 && EF_EXEF_1 DO DispEf CASE nCurrent = 26 && BT_OK DO DispBt CASE nCurrent = 27 && BT_CANCEL DO DispBt CASE nCurrent = 28 && BT_HELP DO DispBt ENDCASE RETURN *-- EOP: Dispatch PROCEDURE DispBt *---------------------------------------------------------------------------- * NAME * DispBt - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_ENTER DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispBt PROCEDURE DispEf *---------------------------------------------------------------------------- * NAME * DispEf - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. CASE nMess = KB_ENTER IF nDlgDef > 0 DO GetNext WITH nDlgDef IF nCurrent = nDlgDef DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF ENDIF CASE nMess = KB_UPARROW DO GetNext WITH .F., .T. CASE nMess = KB_DOWNARROW DO GetNext WITH .T., .T. CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 DO GetNext WITH nPossNext, .F. ENDIF CASE nMess = KB_CTRLW .AND. nAccel > 0 DO GetNext WITH nAccel, .F. ENDCASE RETURN *-- EOP: DispEf PROCEDURE GetNext PARAMETERS p__dir, pl_SameGrp *---------------------------------------------------------------------------- * NAME * GetNext - * * DESCRIPTION * * PARAMETERS * p__dir = .T. to go forward, .F. to go back, number to go to * record number. * pl_SameGrp = .F. to go to first item in next/prev group, .T. will * go to the next/prev item within the same group. Only * applies to p__dir being next/previous. * *---------------------------------------------------------------------------- PRIVATE cPrevClass, nWay, npCurrent, nPointer, nNextObj, nNextPtr PRIVATE nRecNo, npRecNo, lExit, cField, cVar, cCurrClass *------------------------------------------ *-- Check for move out of the current group *------------------------------------------ IF .NOT. pl_SameGrp IF TYPE( "p__dir" ) = "L" DO HasTitle WITH nCurrent, BN_UNHILITE ENDIF ENDIF cPrevClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) *---------------------------------------- *-- Handle the forward and backward moves *---------------------------------------- IF TYPE( "p__dir" ) = "L" DO CASE *------------------------------------------- *-- Go forward or backward in the same group *------------------------------------------- CASE pl_SameGrp nWay = IIF( p__dir, 10, 9 ) && 10 Forward, 9 Back npCurrent = aObjPoint[ nCurrent ] nPointer = npCurrent *----------------------------------------------- *-- Is this a one item radio button or check box *----------------------------------------------- IF aClkObj[ npCurrent, 4 ] <> aClkObj[ npCurrent, nWay ] DO WHILE .T. *------------------------------------------------------ *-- Check to see if the next object's WHEN clause is Ok *------------------------------------------------------ nNextObj = aClkObj[ nPointer, nWay ] IF WhenOk( nNextObj ) nPointer = aObjPoint[ nNextObj ] EXIT ELSE *----------------------------------------------- *-- See if we looped back to the item we were on *----------------------------------------------- nNextPtr = aObjPoint[ nNextObj ] IF nNextPtr = npCurrent EXIT ELSE nPointer = nNextPtr ENDIF ENDIF ENDDO ENDIF IF nPointer <> npCurrent nCurrent = aClkObj[ nPointer, 4 ] nCurrGrp = aClkObj[ nPointer, 5 ] ENDIF OTHERWISE nWay = IIF( p__dir, 6, 7 ) && 6 Forward, 7 Back nRecNo = nCurrent npRecNo = aObjPoint[ nRecNo ] lExit = .F. DO WHILE aClkObj[ npRecNo, 5 ] = nCurrGrp nRecNo = aClkObj[ npRecNo, nWay ] npRecNo = aObjPoint[ nRecNo ] IF aClkObj[ npRecNo, 5 ] = nCurrGrp LOOP ELSE *-------------------------------------------------- *-- Finally, we have moved out of the current group *-------------------------------------------------- nCurrGrp = aClkObj[ npRecNo, 5 ] IF .NOT. WhenOk( nRecNo ) LOOP ELSE nCurrent = nRecNo lExit = .T. ENDIF ENDIF IF lExit EXIT ENDIF ENDDO DO HasTitle WITH nCurrent, BN_HILITE ENDCASE ELSE *------------------------------------------------------- *-- Handle direct moves to objects via Alt key and Mouse *------------------------------------------------------- IF .NOT. WhenOk( p__dir ) nMess = 0 RETURN ENDIF IF nCurrGrp <> aClkObj[ aObjPoint[ p__dir ], 5 ] DO HasTitle WITH nCurrent, BN_UNHILITE DO HasTitle WITH p__dir, BN_HILITE nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] DO CASE CASE nCurrent = 26 DO TButton WITH BN_CLICKED, .F., nCurrent CASE nCurrent = 27 DO TButton WITH BN_CLICKED, .F., nCurrent CASE nCurrent = 28 DO TButton WITH BN_CLICKED, .F., nCurrent ENDCASE ELSE DO HasTitle WITH p__dir, BN_HILITE ENDIF nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] ENDIF *--------------------------------------------------------------- *-- Repaint the Default button if we were on a button before and *-- the target is not a button. *--------------------------------------------------------------- cCurrClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) IF cPrevClass = "BT_" .AND. cCurrClass <> "BT_" DO TButton WITH WM_PAINT, BN_DEFAULT, nDlgDef STORE .T. TO BT_OK ENDIF RETURN *-- EOP: GetNext WITH p__dir, pl_SameGrp FUNCTION WhenOk PARAMETERS pnTarget *---------------------------------------------------------------------------- * NAME * WhenOk - Validate the WHEN condition for a target object * * DESCRIPTION * * PARAMETERS * pnTarget = Object ID to verify against * *---------------------------------------------------------------------------- PRIVATE lWhenOk lWhenOk = .T. RETURN lWhenOk *-- EOF: WhenOk( pnTarget ) FUNCTION GetId PARAMETERS pcVar *---------------------------------------------------------------------------- * NAME * GetId() - Search for memvar name and return current_id *---------------------------------------------------------------------------- PRIVATE nId nId = 0 DO CASE CASE pcVar = "EF_EXEP_0" nId = 6 CASE pcVar = "EF_EXEP_1" nId = 7 CASE pcVar = "EF_CONF_0" nId = 12 CASE pcVar = "EF_CONF_1" nId = 13 CASE pcVar = "EF_EXEF_0" nId = 18 CASE pcVar = "EF_EXEF_1" nId = 19 CASE pcVar = "BT_OK" nId = 26 CASE pcVar = "BT_CANCEL" nId = 27 CASE pcVar = "BT_HELP" nId = 28 ENDCASE RETURN( nId ) *-- EOF: GetId( pcVar) PROCEDURE PostVals *---------------------------------------------------------------------------- * NAME * PostVals - * * DESCRIPTION * *---------------------------------------------------------------------------- IF TYPE( "BDCLINK[1]" ) <> "U" BDCLINK[ 1 ] = EF_EXEP_1 BDCLINK[ 2 ] = EF_CONF_1 BDCLINK[ 3 ] = EF_EXEF_1 BDCLINK[ 4 ] = BT_OK BDCLINK[ 5 ] = BT_CANCEL BDCLINK[ 6 ] = BT_HELP ENDIF RETURN *-- EOP: PostVals PROCEDURE ReleObjs *---------------------------------------------------------------------------- * NAME * ReleObjs - Scan the design DBF file and release the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- RETURN *-- EOP: ReleObjs PROCEDURE IBDCLINK *---------------------------------------------------------------------------- * NAME * IBDCLINK - Builds the Initialization array for this dialog box * * DESCRIPTION * IBDCLINK with create a routine that you can call or cut from this * file to run a dialog box and capture the data on exit. * * To run the dialog box, * SET PROCEDURE TO BDCLINK * DO IBDCLINK * * Running IBDCLINK with use the defaults from the SCR file. The * array will remain in memory after execution. * * REMEMBER, REGENERATING THE DIALOG BOX WILL OVERWRITE THIS PROCEDURE! * *---------------------------------------------------------------------------- PUBLIC ARRAY BDCLINK[ 6 ] *-- EF_EXEP_1 - XXXXXXXXXXXXXXXXXXXXXXXXX BDCLINK[ 1 ] = SPACE( 25 ) *-- EF_CONF_1 - XXXXXXXXXXXXXXXXXXXXXXXXX BDCLINK[ 2 ] = SPACE( 25 ) *-- EF_EXEF_1 - XXXXXXXXXXXXXXXXXXXXXXXXX BDCLINK[ 3 ] = SPACE( 25 ) *-- BT_OK - Ok BDCLINK[ 4 ] = .T. *-- BT_CANCEL - Cancel BDCLINK[ 5 ] = .F. *-- BT_HELP - Help BDCLINK[ 6 ] = .F. *-------------------------------------------------------------- *-- FXL_Cancel is set to .T. is the user Cancels the dialog box *-------------------------------------------------------------- FXL_Cancel = .F. *-------------------------------------------------------------- *-- FXL_NoChng lets the dialog box know that the values in the *-- array are not different from the SCR file defaults. This *-- will allow the dialog box to use the .WIN file for a faster *-- startup. *-------------------------------------------------------------- FXL_NoChng = .T. DO BDCLINK IF .NOT. FXL_Cancel && The user clicked on OK *----------------------------------- *-- Put your Ok processing code here *----------------------------------- ENDIF RELEASE BDCLINK RETURN *-- EOP: IBDCLINK